home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 05 - 1989 / 05.04 Apr 89 / Basic Source / Popup Sample next >
Encoding:
Text File  |  1989-02-11  |  9.2 KB  |  220 lines  |  [TEXT/TRUE]

  1. ! PopUp Menu Demo
  2. ! True Basic version 2.01
  3. ! Requires True Basic Macintosh Developer's ToolKit Libraries
  4. ! by Dave Kelly
  5. ! ©1989 MacTutor
  6.  
  7. REM Open up libraries
  8. LIBRARY "MenuLib*"                ! Menu Manager
  9. LIBRARY "WindowLib*"              ! Window Manager
  10. LIBRARY "DeskLib*"                ! Desk Manager
  11. LIBRARY "EventLib*"               ! Event Manager
  12. LIBRARY "QuickLib*"               ! Quickdraw
  13. LIBRARY "DataLib*"                ! Desk Acc and system calls
  14. LIBRARY "MacLib*"                 ! True Basic event control
  15. LIBRARY "System*"                 ! System Calls
  16.  
  17. REM The following variables are used globally throughout the program
  18. DECLARE DEF NIL$, POINTER$,screenBits$,bounds$,top,left,bottom,right,TopLeft$,H,V
  19. DECLARE DEF OpenDeskAcc,NewWindow$,SystemEdit
  20. DECLARE DEF MenuSelect,PtInRect,TrackGoAway
  21.  
  22. DIM MyMenus$(1:4)
  23. DIM PopItem$(1:3)
  24. CALL SysEnvirons(sysEnvRec$,status)    ! Get current system revision
  25. CALL UnpackEnvirons(sysEnvRec$,envversion, machine,sysversion,processor, hasFPU,hasColorQD,keyboardtype,atversion, sysvrefnum)
  26. IF sysversion=0 then              ! Do we have the right ROM?
  27.    STOP
  28. END IF
  29. CALL TakeMac                      ! turn off True Basic and let the program do its own thing
  30. LET everyevent=-1                 ! event mask for all events
  31. LET doneFlag=0                    ! this flag is set when program ending has been selected.
  32. LET z$=bounds$(screenBits$)       ! Get the size of the screen.
  33. CALL setrect(r$,left(z$)+4,top(z$)+44,right(z$)-4,bottom(z$)-4)
  34. CALL setrect(dragrect$,4,24,right(z$)-4,bottom(z$)-4)
  35. LET myWindow$=NewWindow$(NIL$,r$,"Sample",1,0,POINTER$(-1),1,0)      ! Create a window
  36. CALL SetPort(myWindow$)           ! Access the new window
  37. CALL SetUpMenus                   ! Turn on menus
  38. CALL Drawwindow                   ! Set up window info
  39.  
  40. ! Main Event Loop
  41.  
  42. DO
  43.    CALL SystemTask                ! Handle System tasks/DAs
  44.    CALL GetNextEvent(everyevent,theEvent$,eResult)    ! check for events
  45.    IF eResult<>0 then             ! if no event error occurred then...
  46.       CALL UnpackEvent(theEvent$,what,mess,when,where$,mod)
  47.       SELECT CASE what            ! what represents the kind of event that occurred.
  48.       CASE 1                      ! mouse down event occurred
  49.            CALL FindWindow(where$,whichWindow$,wResult)
  50.            SELECT CASE wResult
  51.            CASE 1                 ! Event was in the menu bar
  52.                 LET mResult=MenuSelect(where$)
  53.                 CALL DoMenu(mResult)
  54.            CASE 2                 ! Event was in a system window
  55.                 CALL SystemClick(theEvent$,whichWindow$)   ! Pass the event to the system
  56.            CASE 3                 ! Event was in the content region of a window
  57.                 CALL GlobalToLocal(where$)  ! convert coordinates for the window
  58.                 IF PtInRect(where$,PopRect$)=1 THEN   ! see if popup was selected
  59.                    CALL PopUpEvent     ! if so, then handle the popup event
  60.                 END IF
  61.            CASE 4                 ! Event in the window's drag region
  62.                 CALL DragWindow(whichWindow$,where$,dragrect$)
  63.            CASE 6                 ! Event in go-away region of active window
  64.                 LET doneFlag=TrackGoAway(whichWindow$,where$)
  65.            CASE else
  66.            END SELECT
  67.       CASE 6                      ! update event occurred
  68.            CALL Packb(w$,1,32,mess)
  69.            CALL BeginUpdate(w$)
  70.            CALL Drawwindow
  71.            CALL DrawPopUp
  72.            CALL EndUpdate(w$)
  73.       CASE else                   ! anything else?
  74.       END SELECT
  75.    END IF
  76. LOOP until doneFlag<>0
  77.  
  78. CALL DisposeWindow(myWindow$)     ! Throw away window handle
  79. CALL ClearMenuBar                 ! Clear Menus
  80. FOR i=Lbound(MyMenus$) to Ubound(MyMenus$)
  81.     CALL DisposeMenu(MyMenus$(i))
  82. NEXT i
  83. CALL GiveMac                      ! Return control back to True Basic
  84. STOP                              ! End the program
  85.  
  86. SUB DrawWindow                    ! Draw message in window
  87.     CALL textfont(2)              ! Set font to New York font
  88.     CALL textsize(12)             ! Set size to 12 point
  89.     CALL textface(1)              ! Set text to bold
  90.     CALL textmode(0)              ! Set to copy mode
  91.     CALL moveto(10,20)
  92.     CALL DrawString("True BASIC Version 2.0 PopUp Menu demo")
  93.     CALL textface(0)              ! Set text to plain
  94. END SUB
  95.  
  96. SUB DoMenu(code)                  ! handle Menu events
  97.     CALL Packb(s$,1,32,code)
  98.     LET MenuNumber=Unpackb(s$,1,-16)
  99.     LET Menuitem = Unpackb(s$,17,-16)
  100.     SELECT CASE MenuNumber
  101.     CASE 1                        ! Apple Menu
  102.          CALL GetItem(MyMenus$(1),MenuItem,name$)
  103.          LET mrefNum=OpenDeskAcc(name$)
  104.          CALL SetPort(mywindow$)
  105.     CASE 2                        ! File Menu
  106.          LET doneFlag=-1
  107.     CASE 3                        ! Edit Menu
  108.          LET z=SystemEdit(Menuitem+1)
  109.     CASE else
  110.     END SELECT
  111.     CALL HiliteMenu(0)
  112. END SUB
  113.  
  114. SUB SetUpMenus
  115.     DECLARE DEF NewMenu$,StringWidth   ! Declare variables used
  116.     DECLARE DEF GetFontInfo$      ! in toolbox functions
  117.  
  118.     LET MyMenus$(1)=NewMenu$(1,chr$(20))    ! The first menu is the
  119.     CALL AddResMenu(MyMenus$(1),"DRVR")     ! Apple menu.
  120.     LET MyMenus$(2)=NewMenu$(2,"File")      ! The File menu is second
  121.     CALL AppendMenu(MyMenus$(2),"Quit")
  122.     LET MyMenus$(3)=NewMenu$(3,"Edit")      ! Next the Edit menu
  123.     CALL AppendMenu(MyMenus$(3),"Cut")
  124.     CALL AppendMenu(MyMenus$(3),"Copy")
  125.     CALL AppendMenu(MyMenus$(3),"Paste")
  126.     LET PopTitle$="PopUp Menu Title:  "     ! Save the pop up title
  127.     LET MyMenus$(4)=NewMenu$(4,PopTitle$)   ! Create the pop up menu
  128.     LET Popitem$(1)="Item 1"
  129.     LET Popitem$(2)="Item 2"
  130.     LET Popitem$(3)="Item 3"
  131.     LET NoOfPopItems=3
  132.     LET PopItem=1
  133.     FOR i=1 to 3
  134.         CALL AppendMenu(MyMenus$(4),Popitem$(i))      ! Add popup items
  135.     NEXT i
  136.     FOR i=lbound(MyMenus$) to Ubound(MyMenus$)-1      ! put the menus into
  137.         CALL insertMenu(MyMenus$(i),0)      ! the menu bar
  138.     NEXT i
  139.     CALL InsertMenu(MyMenus$(4),-1)    ! Add pop up menu
  140.     CALL CheckItem(MyMenus$(4),PopItem,1)   ! check default item
  141.  
  142.     REM Get maximum length of PopUp items
  143.     CALL TextFont(0)              ! Set to system font
  144.     CALL TextSize(12)             ! Set to 12 point size
  145.     CALL GetFontInfo(FontInfo$)
  146.     LET ascent = Unpackb(fontinfo$,1,-16)
  147.     LET descent = Unpackb(fontinfo$,17,-16)
  148.     LET widMax = Unpackb(fontinfo$,33,-16)
  149.     LET leading = Unpackb(fontinfo$,49,-16)
  150.     LET MaxItemLength=0
  151.     FOR i=1 to NoOfPopItems
  152.         LET strwidth=StringWidth(Popitem$(i))
  153.         IF StrWidth>MaxItemLength then LET MaxItemLength=StrWidth
  154.     NEXT i
  155.     CALL DrawPopUp
  156.     CALL DrawMenuBar
  157. END SUB
  158.  
  159. SUB DrawPopUp
  160.     CALL TextFont(0)              ! Set Font to Chicago (System)
  161.     CALL TextSize(12)             ! Set Size to 12 point
  162.     LET Popuptop=100              ! Top of Popup menu
  163.     LET Popupleft=200             ! Left of Popup menu
  164.     CALL SetRect(PopRect$,Popupleft,Popuptop,Popupleft+5+MaxItemLength+13,Popuptop+ascent+descent+leading+1)
  165.     CALL FrameRect(PopRect$)      ! Draw the currently selected item
  166.     CALL MoveTo(Right(PopRect$),Top(PopRect$)+1)
  167.     CALL LineTo(Right(PopRect$),Bottom(PopRect$))
  168.     CALL MoveTo(Left(PopRect$)+1,Bottom(PopRect$))
  169.     CALL LineTo(Right(PopRect$),Bottom(PopRect$))
  170.     LET StrWidth=StringWidth(PopTitle$)
  171.     LET xlocation=Left(PopRect$)-StrWidth
  172.     LET ylocation=(Top(PopRect$)+Bottom(PopRect$))/2+(ascent-descent)/2
  173.     CALL MoveTo(xlocation,ylocation)
  174.     CALL Drawstring(PopTitle$)    ! Draw the Popup menu title
  175.     CALL SetRect(InvertTitleRect$,xlocation-8,Top(PopRect$)+1,Left(PopRect$),Bottom(PopRect$))
  176.     LET xlocation=Left(PopRect$)+13
  177.     CALL MoveTo(xlocation,ylocation)
  178.     CALL Drawstring(PopItem$(PopItem))      ! Draw the currently selected item
  179. END SUB
  180.  
  181. SUB PopUpEvent
  182.     DECLARE DEF PopUpMenuSelect   ! Declare function
  183.     CALL InvertRect(InvertTitleRect$)  ! invert the popup title
  184.     LET TempPoint$=TopLeft$(PopRect$)
  185.     CALL LocalToGlobal(TempPoint$)     ! Change to global coordinates
  186.     LET PopTop=V(TempPoint$)+1
  187.     LET PopLeft=H(TempPoint$)+1
  188.     LET Result=PopUpMenuSelect(MyMenus$(4),PopTop,PopLeft,PopItem)   ! Do the Popup
  189.     CALL Packb(s$,1,32,Result)    ! Get the menu result
  190.     LET MenuNumber=Unpackb(s$,1,-16)   ! Ignore Menunumber, we know which menu this is
  191.     LET Menuitem = Unpackb(s$,17,-16)  ! Get the menu item
  192.     IF MenuItem=PopItem THEN
  193.        CALL InvertRect(InvertTitleRect$)    ! Invert the title to normal if old item selected
  194.     ELSE
  195.        CALL CheckItem(MyMenus$(4),PopItem,0)     ! uncheck last item
  196.        CALL CheckItem(MyMenus$(4),MenuItem,1)    ! check new item
  197.        CALL EraseRect(PopRect$)   ! Draw the current menu item
  198.        CALL FrameRect(PopRect$)
  199.        CALL MoveTo(xlocation,ylocation)
  200.        CALL Drawstring(PopItem$(PopItem))
  201.        CALL InvertRect(InvertTitleRect$)
  202.        SELECT CASE MenuItem       ! Handle menu event
  203.        CASE 1
  204.             REM Do Item 1
  205.             LET PopItem=MenuItem
  206.        CASE 2
  207.             REM Do Item 2
  208.             LET PopItem=MenuItem
  209.        CASE 3
  210.             REM Do Item 3
  211.             LET PopItem=MenuItem
  212.        CASE ELSE
  213.        END SELECT
  214.        CALL MoveTo(xlocation,ylocation)
  215.        CALL TextFont(0)           ! Set font to Chicago (System)
  216.        CALL Drawstring(PopItem$(PopItem))   ! draw the selected popup item
  217.     END IF
  218. END SUB
  219. END
  220.